The Atari Compendium/The Atari Compendium (Toad Computers) (1994).iso/files/prgtools/programm.ing/m2posx10.zoo/m2posix.10/src/sig.ipp

Modula Implementation | 1993-12-23 | 13.1 KB | 542 lines

IMPLEMENTATION MODULE sig;
__IMP_SWITCHES__
#ifdef HM2
#ifdef __LONG_WHOLE__
(*$!i+: Modul muss mit $i- uebersetzt werden! *)
(*$!w+: Modul muss mit $w- uebersetzt werden! *)
#else
(*$!i-: Modul muss mit $i+ uebersetzt werden! *)
(*$!w-: Modul muss mit $w+ uebersetzt werden! *)
#endif
#endif
(*****************************************************************************)
(* Basiert auf der MiNTLIB von Eric R. Smith und anderen                     *)
(* --------------------------------------------------------------------------*)
(* 30-Okt-93, Holger Kleinschmidt                                            *)
(*****************************************************************************)

VAL_INTRINSIC
CAST_IMPORT

FROM PORTAB IMPORT
(* CONST*) NULL,
(* TYPE *) UNSIGNEDWORD, SIGNEDLONG, UNSIGNEDLONG, WORDSETRANGE, WORDSET;

FROM types IMPORT
(* TYPE *) pidT;

IMPORT e;

FROM DosSystem IMPORT
(* VAR  *) BASEP,
(* PROC *) SysClock, DosPid, MiNTVersion;

FROM OSCALLS IMPORT
(* PROC *) Pkill, Psigpause, Psigblock, Psigsetmask, Psigpending, Pause,
           Pterm, Talarm, Fselect;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)

CONST
  EOKL = 0H;
#if no_MIN_MAX
  MINSIG = SIGNULL;
  MAXSIG = SIGUSR2;
#else
  MINSIG = MIN(Signal);
  MAXSIG = MAX(Signal);
#endif

TYPE
  SigDispatcher = PROCEDURE(UNSIGNEDWORD);

TYPE
  MiNTSigset = RECORD
    CASE TAG_COLON BOOLEAN OF
      FALSE: sigset  : sigsetT;
     |TRUE : siglong : UNSIGNEDLONG;
    END;
  END;

VAR
  MiNT       : BOOLEAN;
  SIGMASK    : MiNTSigset;
  SIGPENDING : MiNTSigset;

VAR
#if only_subrange_index
  Handler : ARRAY [MINSIG..MAXSIG] OF SignalHandler;
#else
  Handler : ARRAY Signal OF SignalHandler;
#endif

#if 0
VAR
  Wrapper : RECORD
    code1 : ARRAY [0..2] OF UNSIGNEDLONG;
    call  : SigDispatcher;
    code2 : UNSIGNEDLONG;
  END;
#endif

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)

(* allgemeine Mengenprozeduren, fuer Signalsets beliebiger Groesse *)

PROCEDURE SigsetIsEmpty ((* EIN/ -- *) set : sigsetT ): BOOLEAN;
(**)
VAR __REG__ idx : SigsetRange;
    __REG__ tmp : WORDSET;

BEGIN
 idx := 0;
 tmp := set[MAXSIGSET];
 set[MAXSIGSET] := WORDSET{0..15};
 WHILE set[idx] = WORDSET{} DO
   INC(idx);
 END;

 IF idx = MAXSIGSET THEN
   RETURN(tmp = WORDSET{});
 ELSE
   RETURN(FALSE);
 END;
END SigsetIsEmpty;

(*---------------------------------------------------------------------------*)

PROCEDURE SigsetDiff ((* EIN/ -- *)     from : sigsetT;
                      (* EIN/ -- *)     sub  : sigsetT;
                      (* -- /AUS *) VAR res  : sigsetT );
(**)
VAR __REG__ idx : SigsetRange;

BEGIN
 FOR idx := 0 TO MAXSIGSET DO
   res[idx] := from[idx] - sub[idx];
 END;
END SigsetDiff;

(*---------------------------------------------------------------------------*)

PROCEDURE SigsetUnion ((* EIN/ -- *)     set1 : sigsetT;
                       (* EIN/ -- *)     set2 : sigsetT;
                       (* -- /AUS *) VAR res  : sigsetT );
(**)
VAR __REG__ idx : SigsetRange;

BEGIN
 FOR idx := 0 TO MAXSIGSET DO
   res[idx] := set1[idx] + set2[idx];
 END;
END SigsetUnion;

(*---------------------------------------------------------------------------*)

PROCEDURE SigsetIsMember ((* EIN/ -- *)     sig : Signal;
                          (* EIN/ -- *) VAR set : sigsetT ): BOOLEAN;
(**)
BEGIN
 RETURN(       VAL(WORDSETRANGE,VAL(CARDINAL,sig) MOD 16)
        IN set[VAL(WORDSETRANGE,VAL(CARDINAL,sig) DIV 16)]);
END SigsetIsMember;

(*---------------------------------------------------------------------------*)

PROCEDURE SigsetInclude ((* EIN/ -- *)     sig : Signal;
                         (* EIN/AUS *) VAR set : sigsetT );
(**)
BEGIN
 INCL(set[VAL(WORDSETRANGE,VAL(CARDINAL,sig) DIV 16)],
          VAL(WORDSETRANGE,VAL(CARDINAL,sig) MOD 16) );
END SigsetInclude;

(*---------------------------------------------------------------------------*)

PROCEDURE SigsetExclude ((* EIN/ -- *)     sig : Signal;
                         (* EIN/AUS *) VAR set : sigsetT );
(**)
BEGIN
 EXCL(set[VAL(WORDSETRANGE,VAL(CARDINAL,sig) DIV 16)],
          VAL(WORDSETRANGE,VAL(CARDINAL,sig) MOD 16) );
END SigsetExclude;

(*---------------------------------------------------------------------------*)

PROCEDURE sigemptyset ((* -- /AUS *) VAR set : sigsetT );
(**)
VAR __REG__ idx : SigsetRange;

BEGIN
 FOR idx := 0 TO MAXSIGSET DO
   set[idx] := WORDSET{};
 END;
END sigemptyset;

(*---------------------------------------------------------------------------*)

PROCEDURE sigfillset ((* -- /AUS *) VAR set : sigsetT );
(**)
VAR __REG__ idx : SigsetRange;

BEGIN
 FOR idx := 0 TO MAXSIGSET DO
   set[idx] := WORDSET{0..15};
 END;
END sigfillset;

(*---------------------------------------------------------------------------*)

PROCEDURE sigaddset ((* EIN/AUS *) VAR set : sigsetT;
                     (* EIN/ -- *)     sig : Signal  ): INTEGER;
(**)
BEGIN
 IF ORD(sig) > ORD(MAXSIG) THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 SigsetInclude(sig, set);
 RETURN(0);
END sigaddset;

(*---------------------------------------------------------------------------*)

PROCEDURE sigdelset ((* EIN/AUS *) VAR set : sigsetT;
                     (* EIN/ -- *)     sig : Signal  ): INTEGER;
(**)
BEGIN
 IF ORD(sig) > ORD(MAXSIG) THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 SigsetExclude(sig, set);
 RETURN(0);
END sigdelset;

(*---------------------------------------------------------------------------*)

PROCEDURE sigismember ((* EIN/ -- *) set : sigsetT;
                       (* EIN/ -- *) sig : Signal  ): INTEGER;
(**)
BEGIN
 IF ORD(sig) > ORD(MAXSIG) THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 IF SigsetIsMember(sig, set) THEN
   RETURN(1);
 ELSE
   RETURN(0);
 END;
END sigismember;

(*---------------------------------------------------------------------------*)
#if (defined HM2)
(*$E+*)
#endif
PROCEDURE dispatch ((* EIN/ -- *) sig : UNSIGNEDWORD );
BEGIN
 Handler[VAL(Signal,sig)].proc(VAL(Signal,sig));
END dispatch;
#if (defined HM2)
(*$E=*)
#endif
(*---------------------------------------------------------------------------*)

PROCEDURE sigaction ((* EIN/ -- *) sig  : Signal;
                     (* EIN/ -- *) act  : SigactionPtr;
                     (* EIN/ -- *) oact : SigactionPtr ): INTEGER;
(**)
VAR
BEGIN
 IF ORD(sig) > ORD(MAXSIG) THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 e.errno := e.ENOSYS;
 RETURN(-1);
END sigaction;

(*---------------------------------------------------------------------------*)

PROCEDURE kill ((* EIN/ -- *) pid : pidT;
                (* EIN/ -- *) sig : Signal ): INTEGER;
(**)
VAR handler : SignalHandler;
    dummy   : INTEGER;
    res     : INTEGER;

BEGIN
 IF ORD(sig) > ORD(MAXSIG) THEN
   e.errno := e.EINVAL;
   RETURN(-1);
 END;
 IF MiNT THEN
   IF Pkill(pid, ORD(sig), res) THEN
     RETURN(0);
   ELSE
     e.errno := res;
     RETURN(-1);
   END
 ELSE
   IF (pid < 0) OR (pid > 0) AND (pid <> DosPid(BASEP)) THEN
     e.errno := e.ESRCH;
     RETURN(-1);
   END;
   handler := Handler[sig];
   IF (sig = SIGNULL) OR (handler.long = SigIgn) THEN
     RETURN(0);
   ELSIF (sig <> SIGKILL)
     AND (sig <> SIGSTOP)
     AND SigsetIsMember(sig, SIGMASK.sigset)
   THEN
     SigsetInclude(sig, SIGPENDING.sigset);
   ELSE
     SigsetExclude(sig, SIGPENDING.sigset);
     IF handler.long = SigDfl THEN
       IF (sig = SIGCONT) OR (sig = SIGCHLD) THEN
         RETURN(0);
       ELSE
         Pterm(VAL(CARDINAL,sig) * 256); (* Signal in obere 8 Bit *)
       END;
     ELSE
       handler.proc(sig);
     END;
   END;
 END;
END kill;

(*---------------------------------------------------------------------------*)

PROCEDURE DeliverUnblocked;
(**)
VAR         unblocked : sigsetT;
    __REG__ sig       : Signal;
    __REG__ void      : INTEGER;

BEGIN
 SigsetDiff(SIGPENDING.sigset, SIGMASK.sigset, unblocked);
 IF NOT SigsetIsEmpty(unblocked) THEN
   FOR sig := MINSIG TO MAXSIG DO
     IF SigsetIsMember(sig, unblocked) THEN
       void := kill(0, sig);
     END;
   END;
 END;
END DeliverUnblocked;

(*---------------------------------------------------------------------------*)

PROCEDURE sigprocmask ((* EIN/ -- *) how  : BlockType;
                       (* EIN/ -- *) set  : SigsetPtr;
                       (* EIN/ -- *) oset : SigsetPtr ): INTEGER;
(**)
VAR old     : UNSIGNEDLONG;
    mintsig : MiNTSigset;

BEGIN
 CASE how OF
   SigBlock:
     IF MiNT THEN
       WITH mintsig DO
         IF set = NULL THEN
           siglong := 0;
         ELSE
           sigset  := set^;
         END;
         siglong := Psigblock(siglong);
         IF oset <> NULL THEN
           oset^ := sigset;
         END;
       END;
     ELSE
       WITH SIGMASK DO
         IF oset <> NULL THEN
           oset^ := sigset;
         END;
         IF set <> NULL THEN
           SigsetUnion(sigset, set^, sigset);
         END;
       END;
     END;
  |SigUnBlock:
     IF MiNT THEN
       WITH mintsig DO
         siglong := Psigblock(0);
         IF oset <> NULL THEN
           oset^ := sigset;
         END;
         IF set <> NULL THEN
           SigsetDiff(sigset, set^, sigset);
           old := Psigsetmask(siglong);
         END;
       END;
     ELSE
       WITH SIGMASK DO
         IF oset <> NULL THEN
           oset^ := sigset;
         END;
         IF set <> NULL THEN
           SigsetDiff(sigset, set^, sigset);
           DeliverUnblocked;
         END;
       END;
     END;
  ELSE (* SigSetMask *)
    IF MiNT THEN
      WITH mintsig DO
        IF set = NULL THEN
          siglong := Psigblock(0);
        ELSE
          sigset  := set^;
          siglong := Psigsetmask(siglong);
        END;
        IF oset <> NULL THEN
          oset^ := sigset;
        END;
      END;
    ELSE
      WITH SIGMASK DO
        IF oset <> NULL THEN
          oset^ := sigset;
        END;
        IF set <> NULL THEN
          sigset := set^;
          DeliverUnblocked;
        END;
      END;
    END;
 END;
 RETURN(0);
END sigprocmask;

(*---------------------------------------------------------------------------*)

PROCEDURE sigpending ((* -- /AUS *) VAR set : sigsetT ): INTEGER;
(**)
VAR sigs : MiNTSigset;

BEGIN
 IF MiNT THEN
   WITH sigs DO
     siglong := Psigpending();
     set     := sigset;
   END;
 ELSE;
   set := SIGPENDING.sigset;
 END;
 RETURN(0);
END sigpending;

(*---------------------------------------------------------------------------*)

PROCEDURE pause ( ): INTEGER;
(**)
BEGIN
 IF MiNT THEN
   Pause;
 END;
 e.errno := e.EINTR;
 RETURN(-1);
END pause;

(*---------------------------------------------------------------------------*)

PROCEDURE sigsuspend ((* EIN/ -- *) sigmask : sigsetT ): INTEGER;
(**)
VAR         mask : MiNTSigset;
    __REG__ old  : UNSIGNEDLONG;

BEGIN
 mask.sigset := sigmask;
 IF MiNT THEN
   Psigpause(mask.siglong);
 ELSE
   WITH SIGMASK DO
     old     := siglong;
     SIGMASK := mask;
     DeliverUnblocked;
     siglong := old;
   END;
 END;
 e.errno := e.EINTR;
 RETURN(-1);
END sigsuspend;

(*---------------------------------------------------------------------------*)

PROCEDURE sleep ((* EIN/ -- *) seconds : CARDINAL ): CARDINAL;
(**)
VAR __REG__ until : UNSIGNEDLONG;
    __REG__ void  : BOOLEAN;
            res   : INTEGER;

BEGIN
 IF MiNT THEN
   (* Ab MiNT 1.08 ist 'Fselect' durch Interrupt unterbrechbar *)
   WHILE seconds > 32 DO
     void := Fselect(32000, NULL, NULL, NULL, res);
     DEC(seconds, 32);
   END;
   void := Fselect(1000 * seconds, NULL, NULL, NULL, res);
 ELSE
   until := VAL(UNSIGNEDLONG,seconds);
   INC(until, until);
   INC(until, until);
   INC(until, VAL(UNSIGNEDLONG,seconds));
   INC(until, SysClock());
   REPEAT
   UNTIL SysClock() >= until;
 END;
 RETURN(0);
END sleep;

(*---------------------------------------------------------------------------*)

PROCEDURE alarm ((* EIN/ -- *) sec : CARDINAL ): CARDINAL;
(**)
CONST MAXSEC = LIC(2147483);

VAR __REG__ time : SIGNEDLONG;

BEGIN
 IF MiNT THEN
   time := VAL(SIGNEDLONG,sec);
   IF time > MAXSEC THEN
     (* sonst gibts Ueberlauf in MiNT *)
     time := MAXSEC;
   END;
   RETURN(VAL(CARDINAL,Talarm(time)));
 END;
 RETURN(0);
END alarm;

(*===========================================================================*)

VAR signal : Signal;

BEGIN (* sig *)
 MiNT := MiNTVersion() > 0;
#if 0
 WITH Wrapper DO
#ifdef MM2
(* ???? *)
#else
   code1[0] := 202F0004H; (* move.l  4(SP),D0 *)
   code1[1] := 4E560000H; (* link    A6,#0 *)
   code1[2] := 3F004EB9H; (* move.w  D0,-(SP)  &  jsr ... *)
   call     := dispatch;  (* ... dispatch *)
   code2    := 4E5E4E75H; (* unlk    A6  &  rts *)
#endif
 END;
#endif
 SIGMASK.siglong    := 0H;
 SIGPENDING.siglong := 0H;

 FOR signal := MINSIG TO MAXSIG DO
   Handler[signal].long := SigDfl;
 END;
 Handler[SIGNULL].long := SigIgn;
 Handler[SIGCHLD].long := SigIgn;
END sig.